﻿Imports System.Runtime.InteropServices
Imports System.IO
Imports System.IO.Compression
Imports System.Drawing
Imports Microsoft.DirectX
Imports Microsoft.DirectX.Direct3D
Imports System.Collections.ObjectModel

Friend Module mMirImageLibrary

    'Header for Mil files (22 Bytes)
    <StructLayout(LayoutKind.Sequential)> _
    Public Structure MilHeader
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=20)> Dim Title As String
        <MarshalAs(UnmanagedType.U2)> Dim IndexCount As UInt16
    End Structure

    'Index for Mil files (29 Bytes)
    <StructLayout(LayoutKind.Explicit)> _
    Public Structure MilIndex
        <FieldOffset(0)> <MarshalAs(UnmanagedType.I2)> Dim Width As Int16       'image width
        <FieldOffset(2)> <MarshalAs(UnmanagedType.I2)> Dim Height As Int16      'image height
        <FieldOffset(4)> <MarshalAs(UnmanagedType.I2)> Dim OffsetX As Int16     'offset on x-axis
        <FieldOffset(6)> <MarshalAs(UnmanagedType.I2)> Dim OffsetY As Int16     'offset on y-axis
        <FieldOffset(8)> <MarshalAs(UnmanagedType.I1)> Dim ShadowType As Byte   'shadow type (?)
        <FieldOffset(9)> <MarshalAs(UnmanagedType.I2)> Dim ShadowX As Int16     'shadow offset on x-axis
        <FieldOffset(11)> <MarshalAs(UnmanagedType.I2)> Dim ShadowY As Int16    'shadow offset on y-axis
        <FieldOffset(13)> <MarshalAs(UnmanagedType.U4)> Dim Location As UInt32    'offset of the image in the Mil file
        <FieldOffset(17)> <MarshalAs(UnmanagedType.U4)> Dim DataSize As UInt32   'size of the image data
        <FieldOffset(21)> <MarshalAs(UnmanagedType.U4)> Dim Location2 As UInt32    'offset of the image in the Mil file
        <FieldOffset(25)> <MarshalAs(UnmanagedType.U4)> Dim Data2Size As UInt32   'size of the image data
    End Structure

End Module

Friend Class MirImage

    Dim mHeader As MilIndex
    Dim mTexture As Texture
    Dim mTexture2 As Texture
    Dim mBitmap As Bitmap

    Dim mHasAlpha As Boolean
    Dim mHasImg As Boolean

    Dim mUseBitmaps As Boolean

    Public Sub New(ByVal stream As Stream, ByVal Location As Integer, useBitmaps As Boolean)

        mUseBitmaps = useBitmaps

        If Location = 0 Then HasImage = False : Exit Sub

        Dim BReader As BinaryReader = New BinaryReader(stream)
        stream.Seek(Location, SeekOrigin.Begin)

        mHeader.Width = BReader.ReadInt16()
        mHeader.Height = BReader.ReadInt16()
        mHeader.OffsetX = BReader.ReadInt16()
        mHeader.OffsetY = BReader.ReadInt16()
        mHeader.ShadowType = BReader.ReadByte()
        mHeader.ShadowX = BReader.ReadInt16()
        mHeader.ShadowY = BReader.ReadInt16()
        mHeader.DataSize = BReader.ReadInt32()

        stream.Seek(6, SeekOrigin.Current)

        If mUseBitmaps Then
            LoadBitmap(BReader, stream, Location)
        Else
            LoadTextures(BReader, stream, Location)
        End If


    End Sub

    'Private Sub LoadDXTex()

    '   If mTexture Is Nothing And Not mBitmap Is Nothing Then mTexture = New Texture(DirectX.D3D, mBitmap, 0, Direct3D.Pool.Managed)

    'End Sub

    Private Sub LoadTextures(ByRef BReader As BinaryReader, ByRef stream As Stream, ByVal location As Integer)


        Texture = New Texture(DirectX.D3D, mHeader.Width, mHeader.Height, 1, 0, DirectX.ColorFormat, Pool.Managed)
        Dim GS As GraphicsStream = Texture.LockRectangle(0, LockFlags.Discard)

        Texture2 = New Texture(DirectX.D3D, mHeader.Width, mHeader.Height, 1, 0, DirectX.ColorFormat, Pool.Managed)
        Dim GS2 As GraphicsStream = Texture2.LockRectangle(0, LockFlags.Discard)

        Application.DoEvents()

        Dim TexData() As Byte
        Dim TexDataA() As Byte = {0}

        '''''''''''''load texture
        TexData = LoadImageData(BReader, stream, location, TexDataA)

        GS.Write(TexData)
        GS2.Write(TexDataA)

        Texture.UnlockRectangle(0)
        GS.Dispose()
        Texture2.UnlockRectangle(0)
        GS2.Dispose()

        HasImage = True

    End Sub

    Private Function LoadImageData(ByRef BReader As BinaryReader, ByRef stream As Stream, ByVal location As Integer, Optional ByRef AlphaOut() As Byte = Nothing) As Byte()

        Dim bSeperateAlpha As Boolean = (Not AlphaOut Is Nothing)

        Dim ControlByte As UInt16
        Dim BlockLength As UInt16
        Dim Color As UInt16
        Dim R, G, B As Byte
        Dim I As Integer
        Dim WrittenPixels As Long, LinePixels As Long
        Dim TotalPixels As Long = CType(Header.Width, Integer) * CType(Header.Height, Integer)
        Dim bRender As Boolean


        Dim nullbyteblock() As Byte = New Byte() {0, 0, 0, 0}
        Dim tmpBytes() As Byte


        Dim imgDataSize As Long = 4 * TotalPixels
        Dim imgData(imgDataSize - 1) As Byte
        Dim outStream As New MemoryStream(imgData)
        Dim BWriter As New BinaryWriter(outStream)

        Dim imgDataA() As Byte = {0}
        Dim outStreamA As MemoryStream
        Dim BWriterA As BinaryWriter = Nothing
        If bSeperateAlpha Then
            ReDim imgDataA(imgDataSize - 1)
            outStreamA = New MemoryStream(imgDataA)
            BWriterA = New BinaryWriter(outStreamA)
        End If

        Do While (WrittenPixels < TotalPixels And stream.Position < (mHeader.DataSize * 2) + location)

            ControlByte = BReader.ReadUInt16()

            bRender = (LinePixels < Header.Width)

            BlockLength = BReader.ReadUInt16

            If (BlockLength = &HC0 And Not bRender And (ControlByte = &HC0 Or ControlByte = &HC1 Or ControlByte = &HC2)) Then

                stream.Seek(-2, SeekOrigin.Current)
                LinePixels = 0

            Else

                Select Case ControlByte

                    Case &HC0

                        If (bRender) Then
                            For I = 1 To BlockLength
                                If (LinePixels < Header.Width) Then

                                    BWriter.Write(nullbyteblock)

                                    If bSeperateAlpha Then
                                        BWriterA.Write(nullbyteblock)
                                    End If

                                    WrittenPixels += 1
                                    LinePixels += 1

                                End If
                            Next
                        End If

                    Case &HC1
                        If (bRender) Then
                            For I = 1 To BlockLength

                                If LinePixels < Header.Width Then
                                    Color = BReader.ReadUInt16()
                                    R = ((Color And &HF800) >> 11)
                                    G = ((Color And &H7E0) >> 5)
                                    B = (Color And &H1F)
                                    R = R << 3
                                    G = G << 2
                                    B = B << 3
                                    tmpBytes = New Byte() {B, G, R, 255}
                                    BWriter.Write(tmpBytes)
                                    If bSeperateAlpha Then
                                        BWriterA.Write(nullbyteblock)
                                    End If

                                    WrittenPixels += 1
                                    LinePixels += 1
                                End If

                            Next
                        End If

                    Case &HC2
                        If (bRender) Then
                            For I = 1 To BlockLength

                                If LinePixels < Header.Width Then
                                    Color = BReader.ReadUInt16()
                                    R = ((Color And &HF800) >> 11)
                                    G = ((Color And &H7E0) >> 5)
                                    B = (Color And &H1F)
                                    R = R << 3
                                    G = G << 2
                                    B = B << 3
                                    tmpBytes = New Byte() {B, G, R, 255}

                                    If bSeperateAlpha Then
                                        BWriterA.Write(tmpBytes)
                                        BWriter.Write(nullbyteblock)
                                    Else
                                        BWriter.Write(tmpBytes)
                                    End If

                                    WrittenPixels += 1
                                    LinePixels += 1
                                End If

                            Next
                            HasAlpha = True
                        End If

                    Case Else
                        If (LinePixels >= Header.Width) Then
                            LinePixels = 0
                        End If

                        stream.Seek(-2, SeekOrigin.Current)

                End Select

            End If

        Loop

        If bSeperateAlpha Then
            AlphaOut = imgDataA
        End If

        Return imgData

    End Function

    Private Sub LoadBitmap(ByRef BReader As BinaryReader, ByRef stream As Stream, ByVal location As Integer)

        mBitmap = New Bitmap(mHeader.Width, mHeader.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
        Dim BMPD As System.Drawing.Imaging.BitmapData = mBitmap.LockBits(New Rectangle(0, 0, mHeader.Width, mHeader.Height), System.Drawing.Imaging.ImageLockMode.WriteOnly, System.Drawing.Imaging.PixelFormat.Format32bppArgb)

        Application.DoEvents()

        Dim imgData As Byte() = LoadImageData(BReader, stream, location)

        Marshal.Copy(imgData, 0, BMPD.Scan0, imgData.Length)

        mBitmap.UnlockBits(BMPD)

        HasImage = True

    End Sub

    Public Property Header() As MilIndex
        Get
            Return mHeader
        End Get
        Set(ByVal value As MilIndex)
            mHeader = value
        End Set
    End Property

    Public Property Texture() As Texture
        Get
            Return mTexture
        End Get
        Set(ByVal value As Texture)
            mTexture = value
        End Set
    End Property

    Public Property Texture2() As Texture
        Get
            Return mTexture2
        End Get
        Set(ByVal value As Texture)
            mTexture2 = value
        End Set
    End Property

    Public Property Bitmap() As System.Drawing.Bitmap
        Get
            If mHasImg Then
                Return mBitmap
            Else
                Return Nothing
            End If
        End Get
        Set(ByVal value As System.Drawing.Bitmap)
            mBitmap = value
        End Set
    End Property

    Public Property HasAlpha() As Boolean
        Get
            Return mHasAlpha
        End Get
        Set(ByVal value As Boolean)
            mHasAlpha = value
        End Set
    End Property

    Public Property HasImage() As Boolean
        Get
            Return mHasImg
        End Get
        Set(ByVal value As Boolean)
            mHasImg = value
        End Set
    End Property

    Public Sub Draw(ByRef x As Integer, ByRef y As Integer, ByRef z As Single)

        'abort if the DX texture is not loaded
        If Not mHasImg Then Exit Sub

        If y > DirectX.DispMode.Height Then Exit Sub
        If x + mHeader.Width < 0 Then Exit Sub
        If x > DirectX.DispMode.Width Then Exit Sub
        If y + mHeader.Height < 0 Then Exit Sub

        DirectX.BlitD3D(mTexture, x, y, mHeader.Width, mHeader.Height, z)

    End Sub

    Public Sub DrawAlpha(ByRef x As Integer, ByRef y As Integer, ByRef z As Single)

        'abort if the DX texture is not loaded
        If Not mHasAlpha Then Exit Sub

        If y > DirectX.DispMode.Height Then Exit Sub
        If x + mHeader.Width < 0 Then Exit Sub
        If x > DirectX.DispMode.Width Then Exit Sub
        If y + mHeader.Height < 0 Then Exit Sub

        DirectX.BlitD3D(mTexture2, x, y, mHeader.Width, mHeader.Height, z)

    End Sub

    Public Function Rect(ByRef x As Integer, ByRef y As Integer, Optional ByRef scale As Single = 1.0) As Rectangle

        'calculate the rectangle representing the image bounds on screen
        Return New Rectangle(x * scale, y * scale, mHeader.Width * scale, mHeader.Height * scale)

    End Function

    Public Sub Unload()
        If Not mTexture Is Nothing Then
            mTexture.Dispose()
            mTexture = Nothing
        End If
    End Sub

End Class

Friend Class MirImageLibrary

    Dim mFile As String
    Dim mStream As FileStream

    Dim mHeader As New MilHeader

    Dim mImageLocation() As Int32 '(Of Int32)
    Dim mImages() As MirImage
    Dim mImageIsLoaded() As Boolean
    Dim mImageIsLoading() As Boolean

    Dim objLock As New Object

    Dim mUseBitmaps As Boolean

    Public Sub New(ByRef wil As String, Optional useBitmaps As Boolean = False, Optional loadEditorLib As Boolean = False)

        mUseBitmaps = useBitmaps

        'store file name
        If loadEditorLib Then
            mFile = Main.sAppPath & "\Editor\" & wil
        Else
            mFile = Libs.sDataPath & "\" & wil
        End If

        'load file stream
        mStream = New FileStream(mFile & ".wix", FileMode.Open, FileAccess.Read, FileShare.Read)

        Dim BReader As BinaryReader = New BinaryReader(mStream)

        mStream.Seek(20, SeekOrigin.Begin)

        mHeader.IndexCount = BReader.ReadUInt16()
        ReDim mImageLocation(mHeader.IndexCount)
        ReDim mImages(mHeader.IndexCount)
        ReDim mImageIsLoaded(mHeader.IndexCount)
        ReDim mImageIsLoading(mHeader.IndexCount)

        mStream.Seek(28, SeekOrigin.Begin)

        Try

            'load indexes
            For I As Integer = 1 To mHeader.IndexCount

                If mStream.Position = mStream.Length Then Exit For

                mImageLocation(I) = BReader.ReadInt32()

            Next
        Catch

        End Try

        BReader.Close()

        mStream = New FileStream(mFile & ".wil", FileMode.Open, FileAccess.Read, FileShare.Read)

    End Sub

    Public Sub UnloadImages()

        For Each img As MirImage In mImages
            If Not img Is Nothing Then
                img.Unload()
            End If
        Next

        ReDim mImages(mHeader.IndexCount)
        ReDim mImageIsLoaded(mHeader.IndexCount)

    End Sub

    Public Sub UnloadImage(ByRef index As Integer)

        If mImageIsLoaded(index) Then
            mImageIsLoaded(index) = False
            If Not mImages(index) Is Nothing Then
                mImages(index).Unload()
            End If
        End If

    End Sub

    Public Function Image(ByRef index As Integer, Optional ByRef debugon As Boolean = False, Optional ByRef preload As Boolean = False) As MirImage

        If index > mHeader.IndexCount Then Return Nothing

        'check if the image has already been loaded

        If Not mImageIsLoaded(index) Then

            If preload Then

                If Not mImageIsLoading(index) Then
                    mImageIsLoading(index) = True
                    Dim T As Threading.Thread = New Threading.Thread(AddressOf PreloadImage)
                    T.Start(index)
                End If

            Else

                Dim ret As MirImage

                SyncLock objLock

                    'load the image
                    ret = New MirImage(mStream, mImageLocation(index),mUseBitmaps)
                    'add the image to the collection
                    mImages(index) = ret
                    'add a flag to the IsLoaded collection
                    mImageIsLoaded(index) = True

                End SyncLock


            End If

        End If

        Return mImages(index)

    End Function

    Public Sub PreloadImage(ByVal index As Integer)

        If index > mHeader.IndexCount Then Exit Sub

        'check if the image has already been loaded

        If Not mImageIsLoaded(index) Then

            Dim ret As MirImage

            SyncLock objLock

                'load the image
                ret = New MirImage(mStream, mImageLocation(index),mUseBitmaps)
                'add the image to the collection
                mImages(index) = ret
                'add a flag to the IsLoaded collection
                mImageIsLoaded(index) = True

            End SyncLock

        End If

    End Sub

    Private Function ArrayToStruct(ByRef buffer() As Byte, ByRef t As Type, Optional ByRef offset As Int32 = 0) As Object

        ' pin variable and create
        ' GC handle instance
        Dim gh As GCHandle = GCHandle.Alloc(buffer, GCHandleType.Pinned)
        ' get address of variable
        Dim AddrOfArray As IntPtr = gh.AddrOfPinnedObject()
        Return Marshal.PtrToStructure(New IntPtr(AddrOfArray.ToInt32 + offset), t)
        ' free the handle and unpin variable
        gh.Free()

    End Function

    Protected Overrides Sub Finalize()
        MyBase.Finalize()
        'close streams
        mStream.Close()

        'dispose of textures
        For Each tmp As MirImage In mImages
            If Not tmp Is Nothing Then
                tmp.Unload()
            End If
        Next

    End Sub

    Public ReadOnly Property ImageCount() As Integer
        Get
            Return mHeader.IndexCount
        End Get
    End Property

    Public Sub Dispose()
        Finalize()
    End Sub

End Class